perm filename CB.OLD[MSS,LCS]1 blob sn#098747 filedate 1974-04-22 generic text, type T, neo UTF8
00100		SUBROUTINE CMBN
00200		COMMON /RC/MCLEF(200),IST(4000)
00300		COMMON /FL/JT,N,L,M,NM,J,NT
00400		DIMENSION IP(10),NMS(10),NF(2500)
00500		EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
00550	C *****   ******   ****   ******              ↑ 20 FOR OVERRUN IN IP(11) AT 119
00600	C  USE FILE NAMES CLFX, DRAW1 AND DRAW2.  400 WD LIMIT PER FILE.
00700	102	TYPE 1
00800	1	FORMAT(' TYPE OUTPUT FILE NAME ',$)
00900	10	FORMAT(A5)
00910		DO 122 K=1,10
00955	122	NMS(K)=' '
01000		ACCEPT 10,NM
01100		IF(LOOKD(NM).EQ.0)GO TO 100
01110		IF(N.EQ.'A')GO TO 103
01120	C  FOR ADDING TO COMBINED FILE.
01200		TYPE 101,NM
01300		ACCEPT 10,JT
01400		IF(JT.EQ.'N')GO TO 102
01410	100	IF(N.EQ.'C')GO TO 104
01420		TYPE 52
01430		GO TO 102
01600	104	JT=0
01700		IP(1)=1
01800		L=1
01900		J=1
02000		I=0
02100	30	TYPE 41
02200	41	FORMAT(' TYPE FILE NAME ',$)
02300		ACCEPT 10,NW
02400		IF(NW.EQ.' ')GO TO 8
02500		IF(LOOKD(NW))GO TO 51
02600		TYPE 52
02700		GO TO 30
02800	52	FORMAT(' FILE NOT FOUND'/)
02900	51	I=I+1
03000		NMS(I)=NW
03100		CALL IFILE(20,NW)
03200		IP(L)=J
03300		READ(20,5)M,M,M,M
03400	50	READ(20,5)M,M,(MCLEF(K),K=J,J+M-1)
03500		JT=JT+MCLEF(J)
03600		IF(JT.LT.M)M=JT
03700	7	J=J+M
03800		READ(20,5,END=62)M,M,(MCLEF(K),K=J,J+M-1)
03900		GO TO 7
04500	62	J=JT+1
04600		L=L+1
04700		IF(L.LT.11)GO TO 30
04800		GO TO 80
04900	101	FORMAT(' WRITE OVER ',A5,'.DAT?  Y OR N?  ',$)
04910	8	CALL OFILE(1,NM)
05000		IP(L)=JT+1
05010		JT=JT-1
05100		IF(L.EQ.10)GO TO 80
05200		DO 81 K=L+1,10
05300	81	IP(K)=0
05400	80	WRITE(1,9)IP
05500		J=1
05600		NT=0
05700	14	CALL SAVE(MCLEF(J))
05800		NT=NT+MCLEF(J)+1
05900	11	IF(NT.GT.JT)GO TO 4
05910		J=NT
05920		NT=NT-1
05930		GO TO 14
06300	6	FORMAT(' 9999 ',10A5)
06400	4	WRITE (1,6),NMS
06500		RETURN
07000	9	FORMAT(' 9999 ',10I6)
07200	5	FORMAT(12I)
07210	
07220	1103	TYPE 1104,ID
07230	1104	FORMAT(' FILE FULL -- SAVED AS ',A5)
07240		L=1
07250		JT=MCLEF(1)
07260		GO TO 8
07300	
07400	103	CALL IFILE(20,NM)
07500		READ(20,5)K,IP
07600		NX=1
07700	105	READ(20,5,END=106)K,K,(NF(L),L=NX,NX+K-1)
07800		REREAD 107,L,NMS
07850		IF(NMS(1))GO TO 106
07900		NX=NX+K
08000		GO TO 105
08100	107	FORMAT(I,10A5)
08200	106	TYPE 108,NMS
08300	108	FORMAT(' IDENT. NAMES:'/,10(2XA5))
08400		TYPE 109
08500	109	FORMAT(' TYPE ID NAME -- ',$)
08600		ACCEPT 209,ID
08700	209	FORMAT(A5)
08800		JD=0
08900		DO 110 K=1,10
09000		IF(NMS(K).EQ.ID)JD=K
09100		IF(NMS(K).EQ.' ')GO TO 112
09110	110	IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
09200		K=10
09210	112	JT=K
09300		IF(JD.NE.0)GO TO 111
09310	C ADDS ON TO END
09400		JT=K
09500		N=0
09600		DO 113 K=NX,MCLEF(1)-1+NX
09700		N=N+1
09800	113	NF(K)=MCLEF(N)
09900		NX=NX+N-1
09910		JD=JT
10000	114	NMS(JD)=ID
10100		DO 115 K=1,NX
10200	115	MCLEF(K)=NF(K)
10300	C MOVES IT ALL TO MCLEF
10310		L=JT+1
10355		JT=NX
10400		GO TO 8
10500	
10700	111	N=IP(JD)
10800		NR=MCLEF(1)
10900		M=IP(JD+1)-N
11000		NW=NR-M
11010		NX=NX+NW
11020		IF(NW)201,120,203
11030	201	JA=N+NR
11040		JB=NX-1
11050		JC=1
11060		GO TO 204
11070	203	JA=NX-1
11080		JB=N+NW
11090		JC=-1
11100	204	DO 121 K=JA,JB,JC
11110	121	NF(K)=NF(K-NW)
11200	120	DO 117 K=1,NR
11300		NF(N)=MCLEF(K)
11400	117	N=N+1 
11410	CC	JT=JT-1
11420		IF(NW.EQ.0)GO TO 114
12000		DO 119 K=JD+1,JT+1
12100	119	IP(K)=IP(K)+NW
12200	C  FIXES UP FIRST LINE.
12220	CC123	JT=JT-1
12260	CC	NX=NX-1
12300		GO TO 114
12900		END